home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / turbovis / ptg120co.zip / BBFILE.PAS < prev    next >
Pascal/Delphi Source File  |  1993-11-06  |  14KB  |  121 lines
  1. (* This file was mangled by Mangler 1.13 (c) Copyright 1993 by Berend de Boer *)
  2.  {$IFDEF DPMI} {$S-,I-} {$ELSE} {$F+,O+,R-,Q-,S-,V-,I-} {$ENDIF} UNIT BBFILE ;INTERFACE USES OBJECTS , DOS ;
  3. CONST FMREADONLY =$00 ;FMWRITEONLY =$01 ;FMREADWRITE =$02 ;FMDENYALL =$10 ;FMDENYWRITE =$20 ;FMDENYREAD =$30 ;
  4. FMDENYNONE =$40 ;FMNOWAIT =$100 ;CONST STCREATE =$3C00 ;STOPEN =$3D00 ;TYPE DRIVETYPE =STRING [ 2 ] ;PROCEDURE DOSDEL
  5. (CONST PATH :PATHSTR );PROCEDURE DOSCOPY (SOURCE ,DESTINATION:PATHSTR ;AHELPCTX :WORD );PROCEDURE DOSMOVE
  6. (CONST SOURCE ,DEST:PATHSTR ;AHELPCTX :WORD );PROCEDURE DOSWIPE (CONST PATH :PATHSTR );PROCEDURE DOSTOUCH
  7. (CONST PATH :PATHSTR );CONST IOERRNUM :INTEGER =0 ;PROCEDURE CREATEBAK (CONST FILENAME :PATHSTR ;HELPCTX :WORD );
  8. FUNCTION FCREATE (VAR F :FILE ;AFILEMODE :WORD ):INTEGER ;FUNCTION FDEFAULTEXTENSION (CONST FILENAME :PATHSTR ;
  9. CONST EXT :EXTSTR ):STRING ;FUNCTION FFORCEEXTENSION (CONST FILENAME :PATHSTR ;CONST EXT :EXTSTR ):STRING ;
  10. FUNCTION FFORCEDIR (CONST FILENAME :PATHSTR ;DIR :DIRSTR ):STRING ;FUNCTION FILEEXIST
  11. (CONST FILENAME :PATHSTR ):BOOLEAN ;FUNCTION FILEOPEN (VAR F ):BOOLEAN ;FUNCTION FOPEN (VAR F :FILE ;
  12. AFILEMODE :WORD ):INTEGER ;FUNCTION GETDRIVE :DRIVETYPE ;FUNCTION GETFILENAME (VAR F :FILE ):STRING ;
  13. FUNCTION GETUNIQUEFILENAME :STRING ;FUNCTION IOERROR (CONST S :STRING ;AHELPCTX :WORD ):BOOLEAN ;FUNCTION MATCHFILENAMES
  14. (CONST SOURCE ,DEST:PATHSTR ):STRING ;PROCEDURE SETHANDLECOUNT (HANDLES :WORD );PROCEDURE SETHANDLECOUNTDOS3
  15. (HANDLES :WORD );IMPLEMENTATION USES CRT , BBUTIL , {$IFDEF DPMI} WINAPI , {$ENDIF} BBERROR , BBSTRRES , BBGUI ;
  16. {$I PREAPP.INC} PROCEDURE DOSDEL (CONST PATH:PATHSTR);VAR OIl0:FILE ;O101IO1IOlIl1:SEARCHREC;OIOO:DIRSTR;OO0O:NAMESTR;
  17. OIOl:EXTSTR;BEGIN FSPLIT (PATH , OIOO , OO0O , OIOl );FINDFIRST (PATH , ARCHIVE , O101IO1IOlIl1 );WHILE DOSERROR =0
  18.  DO BEGIN ASSIGN (OIl0 , OIOO + O101IO1IOlIl1.NAME );ERASE (OIl0 );FINDNEXT (O101IO1IOlIl1 );END ;END ;PROCEDURE DOSCOPY
  19. (SOURCE,DESTINATION:PATHSTR;AHELPCTX:WORD);VAR O101IO1IOlIl1:SEARCHREC;O1lO01OlI1lO:WORD;OOlIll0O0lll:POINTER;
  20. O1lIIlO1I0lI,OOO0OOI1ll10:DIRSTR;OII010l00O,O1lO0I00IOlO:NAMESTR;O1010O1I0I10O,OI1OO1IIOl:EXTSTR;
  21. OIl10I10l,OI110IOOO0l0:PDOSSTREAM;PROCEDURE O1lIOlO0O1l1 ;VAR OIOOlO1I0l1:BOOLEAN;O1OOlI1IIIOO:BYTE;
  22. PROCEDURE O101IlO10I10I (VAR OIOOlO1I0l1:BOOLEAN);BEGIN BEEP ;IF BBSTRRES.STRINGS =NIL THEN OIOOlO1I0l1 := USERANSWER
  23. ('Disk is full. Insert new disk in '+ 'drive '+ CHR (O1OOlI1IIIOO + ORD ('A')- 1 ), 0 )=CMYES ELSE OIOOlO1I0l1 :=
  24. USERANSWER (RSGET1 (SINFORMUSER , O1OOlI1IIIOO + ORD ('A')- 1 ), AHELPCTX )=CMYES ;END ;BEGIN SOURCE := FEXPAND (SOURCE
  25. );DESTINATION := FEXPAND (DESTINATION );O1OOlI1IIIOO := ORD (DESTINATION [ 1 ] )- ORD ('A')+ 1 ;FSPLIT (SOURCE ,
  26. O1lIIlO1I0lI , OII010l00O , O1010O1I0I10O );FSPLIT (DESTINATION , OOO0OOI1ll10 , O1lO0I00IOlO , OI1OO1IIOl );FINDFIRST
  27. (SOURCE , ARCHIVE , O101IO1IOlIl1 );WHILE DOSERROR =0  DO BEGIN IF DISKFREE (O1OOlI1IIIOO )< O101IO1IOlIl1.SIZE THEN
  28. BEGIN O101IlO10I10I (OIOOlO1I0l1 );IF OIOOlO1I0l1 THEN EXIT ;END ;OIl10I10l := NEW (PBUFSTREAM , INIT (O1lIIlO1I0lI +
  29. O101IO1IOlIl1.NAME , STOPEN + FMREADONLY + FMDENYWRITE , 8192 ));OI110IOOO0l0 := NEW (PBUFSTREAM , INIT (OOO0OOI1ll10 +
  30. MATCHFILENAMES (O101IO1IOlIl1.NAME , O1lO0I00IOlO + OI1OO1IIOl ), STCREATE + FMWRITEONLY + FMDENYALL , 8192 ));
  31. OI110IOOO0l0 ^. COPYFROM (OIl10I10l ^, OIl10I10l ^. GETSIZE );ASM {} LES DI , OI110IOOO0l0{}
  32. MOV BX , ES : [ DI ] . TDOSSTREAM.HANDLE{} MOV CX , WORD PTR O101IO1IOlIl1.TIME{}
  33. MOV DX , WORD PTR O101IO1IOlIl1.TIME+ 2 {} MOV AX , 5701h {} INT 21h {} END;DISPOSE (OI110IOOO0l0 , DONE );DISPOSE
  34. (OIl10I10l , DONE );FINDNEXT (O101IO1IOlIl1 );END ;END ;BEGIN IF MAXAVAIL < 3 * 8192 THEN BEGIN IF BBSTRRES.STRINGS =NIL
  35. THEN PRINTERROR ('Not enough memory to copy files.', AHELPCTX )ELSE PRINTERROR (RSGET (SNOTENOUGHMEMORY ), AHELPCTX );
  36. DOSERROR := 8 ;END ELSE O1lIOlO0O1l1 ;END ;PROCEDURE DOSMOVE (CONST SOURCE,DEST:PATHSTR;AHELPCTX:WORD);
  37. VAR OI0lOOI1ll1O,O1OO1IIl010I:DRIVETYPE;O101IO1IOlIl1:SEARCHREC;O1lIIlO1I0lI,OOO0OOI1ll10:DIRSTR;
  38. OII010l00O,O1lO0I00IOlO:NAMESTR;O1010O1I0I10O,OI1OO1IIOl:EXTSTR;OIl0:FILE ;OI111IlIOOl0:PATHSTR;BEGIN IF SOURCE =DEST
  39. THEN EXIT ;IF SOURCE [ 2 ] =':'THEN OI0lOOI1ll1O := COPY (SOURCE , 1 , 2 )ELSE OI0lOOI1ll1O := GETDRIVE ;IF DEST [ 2 ]
  40. =':'THEN O1OO1IIl010I := COPY (DEST , 1 , 2 )ELSE O1OO1IIl010I := GETDRIVE ;IF OI0lOOI1ll1O <> O1OO1IIl010I THEN
  41. BEGIN DOSCOPY (SOURCE , DEST , AHELPCTX );DOSDEL (SOURCE );END ELSE BEGIN FSPLIT (SOURCE , O1lIIlO1I0lI , OII010l00O ,
  42. O1010O1I0I10O );FSPLIT (DEST , OOO0OOI1ll10 , O1lO0I00IOlO , OI1OO1IIOl );FINDFIRST (SOURCE , ARCHIVE , O101IO1IOlIl1 );
  43. WHILE DOSERROR =0  DO BEGIN OI111IlIOOl0 := MATCHFILENAMES (O101IO1IOlIl1.NAME , DEST );ASSIGN (OIl0 , O1lIIlO1I0lI +
  44. O101IO1IOlIl1.NAME );DOSDEL (OI111IlIOOl0 );RENAME (OIl0 , OI111IlIOOl0 );FINDNEXT (O101IO1IOlIl1 );END ;END ;END ;
  45. PROCEDURE DOSWIPE (CONST PATH:PATHSTR);VAR OIl0:FILE ;O101IO1IOlIl1:SEARCHREC;PROCEDURE OlOII10100 (VAR OIl0:FILE );
  46. CONST O1lI00Oll1lO:BYTE=0 ;OI1II1OIOIOl:BYTE=$FF ;OI1IIO00I1ll:BYTE=$F6 ;VAR OIO11IOOlO0:WORD;OIlO:LONGINT;OIll:WORD;
  47. BEGIN RESET (OIl0 , 1 );FOR OIll := 1 TO 3  DO BEGIN SEEK (OIl0 , 0 );FOR OIlO := 0 TO FILESIZE (OIl0 )- 1  DO BLOCKWRITE
  48. (OIl0 , OI1II1OIOIOl , 1 , OIO11IOOlO0 );SEEK (OIl0 , 0 );FOR OIlO := 0 TO FILESIZE (OIl0 )- 1  DO BLOCKWRITE (OIl0 ,
  49. O1lI00Oll1lO , 1 , OIO11IOOlO0 );END ;SEEK (OIl0 , 0 );FOR OIlO := 0 TO FILESIZE (OIl0 )- 1  DO BLOCKWRITE (OIl0 ,
  50. OI1IIO00I1ll , 1 , OIO11IOOlO0 );CLOSE (OIl0 );END ;PROCEDURE OOlI1IlI0O0O ;BEGIN RESET (OIl0 );TRUNCATE (OIl0 );CLOSE
  51. (OIl0 );RENAME (OIl0 , 'TMP00000.$$$');END ;VAR OIOO:DIRSTR;OO0O:NAMESTR;OIOl:EXTSTR;BEGIN FSPLIT (PATH , OIOO , OO0O ,
  52. OIOl );FINDFIRST (PATH , ARCHIVE , O101IO1IOlIl1 );WHILE DOSERROR =0  DO BEGIN ASSIGN (OIl0 , OIOO + O101IO1IOlIl1.NAME
  53. );OlOII10100 (OIl0 );OOlI1IlI0O0O ;ERASE (OIl0 );FINDNEXT (O101IO1IOlIl1 );END ;END ;PROCEDURE DOSTOUCH
  54. (CONST PATH:PATHSTR);VAR O101IO1IOlIl1:SEARCHREC;OIl0:FILE ;OI111O0100ll:LONGINT;OO1l:DATETIME;
  55. OOIl,OIO0OI11l1l,O101OO1O,OIlO11001ll:WORD;OIlI,OO0I,OO1O,O10lO0O0:WORD;OIOO:DIRSTR;OO0O:NAMESTR;OIOl:EXTSTR;
  56. BEGIN FSPLIT (PATH , OIOO , OO0O , OIOl );FINDFIRST (PATH , ARCHIVE , O101IO1IOlIl1 );WHILE DOSERROR =0  DO BEGIN ASSIGN
  57. (OIl0 , OIOO + O101IO1IOlIl1.NAME );RESET (OIl0 , 1 );GETFTIME (OIl0 , OI111O0100ll );UNPACKTIME (OI111O0100ll , OO1l );
  58. GETDATE (OOIl , OIO0OI11l1l , O101OO1O , OIlO11001ll );GETTIME (OIlI , OO0I , OO1O , O10lO0O0 );WITH OO1l DO BEGIN YEAR
  59. := OOIl ;MONTH := OIO0OI11l1l ;DAY := O101OO1O ;HOUR := OIlI ;MIN := OO0I ;SEC := OO1O ;END ;PACKTIME (OO1l ,
  60. OI111O0100ll );SETFTIME (OIl0 , OI111O0100ll );CLOSE (OIl0 );FINDNEXT (O101IO1IOlIl1 );END ;END ;PROCEDURE CREATEBAK
  61. (CONST FILENAME:PATHSTR;HELPCTX:WORD);BEGIN IF FILEEXIST (FILENAME )THEN DOSMOVE (FILENAME , FFORCEEXTENSION (FILENAME ,
  62. '.BAK'), HELPCTX );END ;FUNCTION FCREATE (VAR F:FILE ;AFILEMODE:WORD):INTEGER ;VAR OIO11IOOlO0:WORD;BEGIN IF AFILEMODE
  63. AND FMWRITEONLY <> 0 THEN BEGIN AFILEMODE := AFILEMODE AND NOT FMWRITEONLY ;AFILEMODE := AFILEMODE OR FMREADWRITE ;END ;
  64. REPEAT REWRITE (F , 1 );OIO11IOOlO0 := IORESULT ;IF OIO11IOOlO0 =0 THEN BEGIN CLOSE (F );OIO11IOOlO0 := FOPEN (F ,
  65. AFILEMODE );END ;UNTIL (AFILEMODE AND FMNOWAIT =0 )OR (OIO11IOOlO0 =0 );FCREATE := OIO11IOOlO0 ;END ;
  66. FUNCTION FDEFAULTEXTENSION (CONST FILENAME:PATHSTR;CONST EXT:EXTSTR):STRING ;BEGIN IF POS ('.', FILENAME )=0 THEN
  67. FDEFAULTEXTENSION := FILENAME + EXT ELSE FDEFAULTEXTENSION := FILENAME ;END ;FUNCTION FFORCEEXTENSION
  68. (CONST FILENAME:PATHSTR;CONST EXT:EXTSTR):STRING ;VAR OIOO:DIRSTR;OO0O:NAMESTR;OIOl:EXTSTR;BEGIN FSPLIT (FILENAME , OIOO
  69. , OO0O , OIOl );FFORCEEXTENSION := OIOO + OO0O + EXT ;END ;FUNCTION FFORCEDIR (CONST FILENAME:PATHSTR;DIR:DIRSTR):STRING
  70. ;VAR OIOO:DIRSTR;OO0O:NAMESTR;OIOl:EXTSTR;BEGIN FSPLIT (FILENAME , OIOO , OO0O , OIOl );IF DIR [ LENGTH (DIR )] <>
  71. '\'THEN DIR := DIR + '\';FFORCEDIR := DIR + OO0O + OIOl ;END ;FUNCTION FILEEXIST (CONST FILENAME:PATHSTR):BOOLEAN ;
  72. VAR O101IO1IOlIl1:SEARCHREC;BEGIN FINDFIRST (FILENAME , ARCHIVE , O101IO1IOlIl1 );FILEEXIST := DOSERROR =0 ;END ;
  73. FUNCTION FILEOPEN (V